home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d17 / prtfile.arc / PRTFILE.PAS < prev   
Pascal/Delphi Source File  |  1987-11-12  |  10KB  |  287 lines
  1. program prtfile ;
  2.   { Prints a text file on the list device, formatted with various
  3.     user-supplied options.  Turbo Pascal, MS/PC-DOS.  Public Domain.
  4.  
  5.     Bill Meacham
  6.     1004 Elm Street, Austin, Tx  78703
  7.  
  8.     This revision picks up the DOS date and time and puts it into the header.
  9.  
  10.     To quit, enter a blank file name when it asks you for one.
  11.     To quit prematurely, type any letter.  It will ask if you want to
  12.     quit.
  13.  
  14.     Last modified: 11/12/87 }
  15.  
  16. {$V-}  { Turn off strict type-checking for strings }
  17.  
  18. label            99 ;               { for premature exit }
  19.  
  20. const
  21.     formfeed   = ^L ;
  22.     bell       = ^G ;
  23.     linelength = 255 ;              { max length of text file lines }
  24.  
  25. type
  26.     st_typ  = string[linelength] ;
  27.     regpack = record case integer of
  28.                 1: (AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags : integer) ;
  29.                 2: (AL,AH,BL,BH,CL,CH,DL,DH : byte)
  30.                end ;
  31.     str14   = string[14] ;
  32.     str66   = string[66] ;
  33.  
  34. var
  35.     registers                  : regpack ;
  36.     line, header               : st_typ ;      { print lines }
  37.     blank_line                 : st_typ ;      { to add indentation }
  38.     page_num,line_cnt, i, n, p : integer ;     { counters }
  39.     indent, spacing, max_lines : integer ;     { user-supplied }
  40.     first_page, last_page      : integer ;     { user_supplied }
  41.     fname                      : string[66] ;  { file name }
  42.     ipt_file                   : text ;        { input file }
  43.     ok                         : boolean ;     { whether file exists }
  44.     reply                      : char ;        { to get user response }
  45.     quit                       : boolean ;     { to flag when last page printed }
  46.  
  47. { ----------------------------------------------------------------- }
  48.  
  49. function date_and_time : str14 ;
  50.   { get DOS system date and time }
  51.  
  52. var
  53.   year,
  54.   month,day,
  55.   hour,min  : string[2] ;
  56.  
  57. begin
  58.   with registers do
  59.     begin
  60.       AX := $2A00 ;
  61.       msdos(registers) ;
  62.       str(CX-1900,year) ;
  63.       str(DH,month) ;
  64.       str(DL,day) ;
  65.       AX := $2C00 ;
  66.       msdos (registers) ;
  67.       str(CH:2,hour) ;
  68.       str(CL:2,min) ;
  69.     end ;
  70.   if  min[1] = ' ' then  min[1] := '0' ;
  71.   if  (hour[1] = ' ')
  72.   and (hour[2] = '0') then
  73.       hour := '00' ;
  74.   date_and_time := concat (month,'/',day,'/',year,' ',hour,':',min) ;
  75. end ; { function getdate }
  76.  
  77. { ----------------------------------------------------------------- }
  78.  
  79. procedure print_page_header ;
  80.   { prints header line at top of each page -- revised, 11/17/84 }
  81.     var
  82.         i : integer ;
  83.     begin
  84.         page_num := page_num + 1 ;
  85.         if page_num > last_page then
  86.             quit := true
  87.         else
  88.           begin
  89.             if page_num >= first_page then
  90.               begin
  91.                 if page_num > first_page then
  92.                     write (lst, formfeed) ;
  93.                 writeln (lst) ;
  94.                 write (lst, header) ;
  95.                 writeln (lst, page_num) ;
  96.                 writeln (lst) ;
  97.                 for i := 1 to spacing do
  98.                     writeln (lst)
  99.               end ;
  100.             line_cnt := 3 + spacing
  101.           end
  102.     end ;  { proc print_page_header }
  103.  
  104. { ----------------------------------------------------------------- }
  105.  
  106. procedure print (line : st_typ ; num_newlines : integer) ;
  107.   { prints a line and the number of newlines indicated }
  108.     var
  109.         i : integer ;
  110.     begin
  111.         if line_cnt > max_lines then
  112.             print_page_header ;
  113.         if  (page_num >= first_page)
  114.         and (page_num <= last_page) then
  115.           begin
  116.             write (lst,line) ;
  117.             for i := 1 to num_newlines do
  118.                 writeln (lst)
  119.           end ;
  120.         line_cnt := line_cnt + num_newlines
  121.     end ;  { proc print }
  122.  
  123. { ----------------------------------------------------------------- }
  124.  
  125. procedure add_blanks (var st : st_typ ; num_blanks : integer) ;
  126.   { appends the number of blanks indicated to the string }
  127.     var
  128.         i : integer ;
  129.     begin
  130.         for i := 1 to num_blanks do
  131.             st := concat (st,' ')
  132.     end ;  { proc add_blanks }
  133.  
  134. { ----------------------------------------------------------------- }
  135.  
  136. function adjust_line (line : st_typ) : st_typ ;
  137.   { Converts tabs to spaces and adds indentation by moving characters
  138.     one by one from the input string to a work string.  If it encounters
  139.     a tab character it expands the tab to the proper number of spaces.
  140.     Finally, the indentation string is inserted in front of all the
  141.     characters and the function returns the work string. }
  142.     
  143.     const
  144.         tab = ^I ;
  145.     var
  146.         i            : integer ;    { loop counter }
  147.         next_char    : integer ;    { where the next character goes
  148.                                       in the work string }
  149.         work_str     : st_typ ;     { work string to build adjusted line }
  150.     begin
  151.         work_str := '' ;
  152.         next_char := 1 ;
  153.         for i := 1 to length(line) do
  154.             if not (line[i] = tab) then
  155.               begin
  156.                 work_str := concat(work_str,line[i]) ;
  157.                 next_char := next_char + 1
  158.               end
  159.             else         { character is a tab -- convert to spaces }
  160.                 repeat
  161.                     work_str := concat(work_str,' ') ;
  162.                     next_char := next_char + 1
  163.                 until (next_char > 8) and ((next_char mod 8) = 1) ;
  164.         insert (blank_line,work_str,1) ;
  165.         adjust_line := work_str
  166.     end ;  { --- proc adjust_line --- }
  167.  
  168. { ----------------------------------------------------------------- }
  169.  
  170. begin { --- MAIN --- }
  171.     while true do                            { endless loop }
  172.       begin
  173.         writeln ;
  174.         writeln ('This prints a text file, paginated with header and DOS date & time.') ;
  175.         writeln ('Please specify options --  <cr> on file name to cancel.') ;
  176.         writeln ('Defaults are no indent, single spacing, 58 lines per page,') ;
  177.         writeln ('start at first page, stop after last.') ;
  178.         writeln ;
  179.  
  180.         repeat
  181.             fname := '' ;                    { get file name }
  182.             write   ('File name? ') ;
  183.             readln  (fname) ;
  184.             for n := 1 to length(fname) do
  185.                 fname[n] := upcase(fname[n]) ;
  186.             if fname = '' then
  187.                 halt                         { --- Exit loop here --- }
  188.             else
  189.               begin
  190.                 assign (ipt_file,fname) ;
  191.                 {$i-}
  192.                 reset (ipt_file) ;
  193.                 {$i+}
  194.                 ok := (ioresult = 0) ;
  195.                 if not ok then
  196.                   begin
  197.                     writeln (bell,'File ',fname,' not found.') ;
  198.                     fname := ''
  199.                   end
  200.               end
  201.         until ok ;
  202.  
  203.         indent := 0 ;                        { get indentation }
  204.         write   ('Number of spaces to indent? ') ;
  205.         readln  (indent) ;
  206.         if indent < 0 then indent := 0 ;
  207.         blank_line := '' ;
  208.         if not (indent = 0 ) then
  209.             for i := 1 to indent do
  210.                 blank_line := concat (' ',blank_line) ;
  211.  
  212.         spacing := 0 ;                       { get spacing }
  213.         write   ('Line spacing? ') ;
  214.         readln  (spacing) ;
  215.         if spacing < 1 then spacing := 1 ;
  216.  
  217.         max_lines := 0 ;                     { get page length }
  218.         write   ('Max lines per page? ') ;
  219.         readln  (max_lines) ;
  220.         if max_lines < 1 then
  221.             max_lines := 58 ;
  222.  
  223.         line := '' ;                         { get header }
  224.         write  ('Header? ') ;
  225.         readln (line) ;
  226.  
  227.         first_page := 0 ;                    { get first page to print }
  228.         write ('Start at what page? ') ;
  229.         readln (first_page) ;
  230.         if first_page < 1 then
  231.             first_page := 1 ;
  232.  
  233.         last_page := 0 ;                     { get last page to print }
  234.         write ('Quit after what page? ') ;
  235.         readln (last_page) ;
  236.         if last_page < 1 then
  237.             last_page := maxint ;
  238.  
  239.         header := blank_line ;               { build header line }
  240.         header := concat(header,fname,'  ',line) ;
  241.         if length(header) < 57 then
  242.             add_blanks (header, 57 - length(header))
  243.         else
  244.             add_blanks (header,2) ;
  245.         header := concat (header,date_and_time,' Page ') ;
  246.         page_num := 0 ;
  247.         line_cnt := maxint ;                 { force first page header }
  248.  
  249.         quit := false ;
  250.         writeln ('Printing ',fname) ;
  251.         while not (eof(ipt_file)) do         { print the text file }
  252.           begin
  253.             readln (ipt_file,line) ;
  254.             if not (indent = 0) then         { add identation }
  255.                 line := adjust_line (line) ;
  256.             repeat
  257.                 n := pos(formfeed,line) ;    { handle embedded formfeeds }
  258.                 if not (n = 0) then
  259.                   begin
  260.                     print (copy(line,1,n-1),spacing) ;
  261.                     print_page_header ;
  262.                     if quit then
  263.                         goto 99 ;
  264.                     delete (line,1,n) ;
  265.                     for i := 1 to indent do
  266.                         line := concat(' ',line) ;
  267.                   end
  268.             until n = 0 ;
  269.             print  (line,spacing) ;
  270.  
  271.             if keypressed then               { check for premature exit }
  272.               begin
  273.                 writeln ;
  274.                 write  ('+++ Quit now? (Y/N): ') ;
  275.                 readln (reply) ;
  276.                 if upcase(reply) = 'Y' then
  277.                     goto 99
  278.               end ;
  279.             if quit then
  280.                 goto 99
  281.           end ;
  282.  
  283. 99:         write (lst,formfeed) ;
  284.         writeln (bell,'Done!')
  285.       end
  286. end.
  287.